home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1995 March / PC Plus Super CD (Issue 101) (March 1995).iso / sharewar / vbaddon / vbfiles / sam4main.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-07-07  |  70.8 KB  |  1,821 lines
  1. VERSION 2.00
  2. Begin Form frmMainForm 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "VB/ISAM Sample Program SAM4 -- browse/edit ""VB Companion Products"" database"
  5.    ClientHeight    =   6825
  6.    ClientLeft      =   300
  7.    ClientTop       =   345
  8.    ClientWidth     =   9270
  9.    FontBold        =   -1  'True
  10.    FontItalic      =   0   'False
  11.    FontName        =   "MS Sans Serif"
  12.    FontSize        =   12
  13.    FontStrikethru  =   0   'False
  14.    FontUnderline   =   0   'False
  15.    Height          =   7230
  16.    Icon            =   SAM4MAIN.FRX:0000
  17.    Left            =   240
  18.    LinkTopic       =   "Form1"
  19.    MaxButton       =   0   'False
  20.    ScaleHeight     =   6825
  21.    ScaleWidth      =   9270
  22.    Top             =   0
  23.    Width           =   9390
  24.    Begin CommonDialog cdbExport 
  25.       CancelError     =   -1  'True
  26.       Filter          =   "Comma-separated values|*.CSV"
  27.       FilterIndex     =   1
  28.       Left            =   4380
  29.       Top             =   3180
  30.    End
  31.    Begin Timer tmrTimer1 
  32.       Enabled         =   0   'False
  33.       Interval        =   150
  34.       Left            =   4050
  35.       Top             =   3180
  36.    End
  37.    Begin CommonDialog cdbOpenADataset 
  38.       CancelError     =   -1  'True
  39.       Filter          =   "VB/ISAM dataset|*.ISM"
  40.       FilterIndex     =   1
  41.       Left            =   4380
  42.       Top             =   3090
  43.    End
  44.    Begin SSPanel pnlMainDisplay 
  45.       Align           =   2  'Align Bottom
  46.       Alignment       =   0  'Left Justify - TOP
  47.       BackColor       =   &H00C0C0C0&
  48.       BevelInner      =   1  'Inset
  49.       Font3D          =   2  'Raised w/heavy shading
  50.       FontBold        =   -1  'True
  51.       FontItalic      =   0   'False
  52.       FontName        =   "MS Sans Serif"
  53.       FontSize        =   12
  54.       FontStrikethru  =   0   'False
  55.       FontUnderline   =   0   'False
  56.       ForeColor       =   &H00FF0000&
  57.       Height          =   5745
  58.       Left            =   0
  59.       TabIndex        =   18
  60.       Top             =   1080
  61.       Width           =   9270
  62.       Begin SSPanel pnlDatasetName 
  63.          Alignment       =   1  'Left Justify - MIDDLE
  64.          BackColor       =   &H00C0C0C0&
  65.          BevelOuter      =   0  'None
  66.          Caption         =   "Dataset name: [click Open]"
  67.          Font3D          =   2  'Raised w/heavy shading
  68.          FontBold        =   -1  'True
  69.          FontItalic      =   0   'False
  70.          FontName        =   "MS Sans Serif"
  71.          FontSize        =   12
  72.          FontStrikethru  =   0   'False
  73.          FontUnderline   =   0   'False
  74.          ForeColor       =   &H00FF0000&
  75.          Height          =   375
  76.          Left            =   210
  77.          TabIndex        =   21
  78.          Top             =   90
  79.          Width           =   8955
  80.       End
  81.       Begin SSPanel pnlUpdateButtons 
  82.          BackColor       =   &H00C0C0C0&
  83.          BevelInner      =   1  'Inset
  84.          Font3D          =   2  'Raised w/heavy shading
  85.          ForeColor       =   &H00FF0000&
  86.          Height          =   3705
  87.          Left            =   7110
  88.          TabIndex        =   25
  89.          Top             =   1800
  90.          Width           =   1935
  91.          Begin SSCommand cmdClearDisplay 
  92.             Caption         =   "Clear/Restore Display"
  93.             Enabled         =   0   'False
  94.             Font3D          =   0  'None
  95.             FontBold        =   0   'False
  96.             FontItalic      =   0   'False
  97.             FontName        =   "MS Sans Serif"
  98.             FontSize        =   8.25
  99.             FontStrikethru  =   0   'False
  100.             FontUnderline   =   0   'False
  101.             Height          =   870
  102.             Left            =   90
  103.             Outline         =   0   'False
  104.             Picture         =   SAM4MAIN.FRX:0302
  105.             TabIndex        =   13
  106.             Top             =   90
  107.             Width           =   1755
  108.          End
  109.          Begin SSCommand cmdUpdateRec 
  110.             Caption         =   "Update This Record"
  111.             Enabled         =   0   'False
  112.             Font3D          =   0  'None
  113.             FontBold        =   0   'False
  114.             FontItalic      =   0   'False
  115.             FontName        =   "MS Sans Serif"
  116.             FontSize        =   8.25
  117.             FontStrikethru  =   0   'False
  118.             FontUnderline   =   0   'False
  119.             Height          =   885
  120.             Left            =   90
  121.             Outline         =   0   'False
  122.             Picture         =   SAM4MAIN.FRX:0604
  123.             TabIndex        =   16
  124.             Top             =   2730
  125.             Width           =   1755
  126.          End
  127.          Begin SSCommand cmdDeleteRec 
  128.             Caption         =   "Delete This Record"
  129.             Enabled         =   0   'False
  130.             Font3D          =   0  'None
  131.             FontBold        =   0   'False
  132.             FontItalic      =   0   'False
  133.             FontName        =   "MS Sans Serif"
  134.             FontSize        =   8.25
  135.             FontStrikethru  =   0   'False
  136.             FontUnderline   =   0   'False
  137.             Height          =   885
  138.             Left            =   90
  139.             Outline         =   0   'False
  140.             Picture         =   SAM4MAIN.FRX:0906
  141.             TabIndex        =   15
  142.             Top             =   1845
  143.             Width           =   1755
  144.          End
  145.          Begin SSCommand cmdAddRec 
  146.             Caption         =   "Add This Record"
  147.             Enabled         =   0   'False
  148.             Font3D          =   0  'None
  149.             FontBold        =   0   'False
  150.             FontItalic      =   0   'False
  151.             FontName        =   "MS Sans Serif"
  152.             FontSize        =   8.25
  153.             FontStrikethru  =   0   'False
  154.             FontUnderline   =   0   'False
  155.             Height          =   885
  156.             Left            =   90
  157.             Outline         =   0   'False
  158.             Picture         =   SAM4MAIN.FRX:0C08
  159.             TabIndex        =   14
  160.             Top             =   960
  161.             Width           =   1755
  162.          End
  163.       End
  164.       Begin SSPanel pnlCombo 
  165.          BackColor       =   &H00C0C0C0&
  166.          BevelInner      =   1  'Inset
  167.          Font3D          =   2  'Raised w/heavy shading
  168.          ForeColor       =   &H00FF0000&
  169.          Height          =   495
  170.          Left            =   7110
  171.          TabIndex        =   24
  172.          Top             =   900
  173.          Width           =   1935
  174.          Begin ComboBox cboIndex 
  175.             BackColor       =   &H00FFFF00&
  176.             FontBold        =   0   'False
  177.             FontItalic      =   0   'False
  178.             FontName        =   "MS Sans Serif"
  179.             FontSize        =   8.25
  180.             FontStrikethru  =   0   'False
  181.             FontUnderline   =   0   'False
  182.             Height          =   300
  183.             Left            =   90
  184.             Sorted          =   -1  'True
  185.             Style           =   2  'Dropdown List
  186.             TabIndex        =   12
  187.             Top             =   90
  188.             Width           =   1755
  189.          End
  190.       End
  191.       Begin SSPanel pnlIndexName 
  192.          BackColor       =   &H00C0C0C0&
  193.          BevelOuter      =   0  'None
  194.          Caption         =   "Index field:"
  195.          Font3D          =   2  'Raised w/heavy shading
  196.          FontBold        =   -1  'True
  197.          FontItalic      =   0   'False
  198.          FontName        =   "MS Sans Serif"
  199.          FontSize        =   12
  200.          FontStrikethru  =   0   'False
  201.          FontUnderline   =   0   'False
  202.          ForeColor       =   &H00FF0000&
  203.          Height          =   375
  204.          Left            =   7110
  205.          TabIndex        =   23
  206.          Top             =   480
  207.          Width           =   1425
  208.       End
  209.       Begin SSPanel pnlList 
  210.          BackColor       =   &H00C0C0C0&
  211.          BevelInner      =   1  'Inset
  212.          Font3D          =   0  'None
  213.          Height          =   3705
  214.          Left            =   240
  215.          TabIndex        =   20
  216.          Top             =   1800
  217.          Width           =   6735
  218.          Begin PictureBox picFieldDisplayArea 
  219.             BackColor       =   &H00C0C0C0&
  220.             BorderStyle     =   0  'None
  221.             Height          =   3525
  222.             Left            =   90
  223.             ScaleHeight     =   3525
  224.             ScaleWidth      =   6555
  225.             TabIndex        =   27
  226.             TabStop         =   0   'False
  227.             Top             =   90
  228.             Visible         =   0   'False
  229.             Width           =   6555
  230.             Begin TextBox txtFieldVal 
  231.                Height          =   285
  232.                Index           =   10
  233.                Left            =   2130
  234.                TabIndex        =   26
  235.                Top             =   3180
  236.                Width           =   4275
  237.             End
  238.             Begin TextBox txtFieldVal 
  239.                Height          =   285
  240.                Index           =   9
  241.                Left            =   2130
  242.                TabIndex        =   48
  243.                Top             =   2865
  244.                Width           =   1695
  245.             End
  246.             Begin TextBox txtFieldVal 
  247.                Height          =   285
  248.                Index           =   8
  249.                Left            =   2130
  250.                TabIndex        =   47
  251.                Top             =   2550
  252.                Width           =   1695
  253.             End
  254.             Begin TextBox txtFieldVal 
  255.                Height          =   285
  256.                Index           =   7
  257.                Left            =   2130
  258.                MaxLength       =   35
  259.                TabIndex        =   46
  260.                Top             =   2235
  261.                Width           =   4275
  262.             End
  263.             Begin TextBox txtFieldVal 
  264.                Height          =   285
  265.                Index           =   6
  266.                Left            =   2130
  267.                MaxLength       =   3
  268.                TabIndex        =   45
  269.                Top             =   1920
  270.                Width           =   495
  271.             End
  272.             Begin TextBox txtFieldVal 
  273.                Height          =   285
  274.                Index           =   5
  275.                Left            =   2130
  276.                TabIndex        =   44
  277.                Top             =   1605
  278.                Width           =   4275
  279.             End
  280.             Begin TextBox txtFieldVal 
  281.                Height          =   285
  282.                Index           =   4
  283.                Left            =   2130
  284.                TabIndex        =   43
  285.                Top             =   1290
  286.                Width           =   1755
  287.             End
  288.             Begin TextBox txtFieldVal 
  289.                Height          =   285
  290.                Index           =   3
  291.                Left            =   2130
  292.                MaxLength       =   3
  293.                TabIndex        =   42
  294.                Top             =   975
  295.                Width           =   495
  296.             End
  297.             Begin TextBox txtFieldVal 
  298.                Height          =   285
  299.                Index           =   2
  300.                Left            =   2130
  301.                MaxLength       =   45
  302.                TabIndex        =   41
  303.                Top             =   660
  304.                Width           =   4275
  305.             End
  306.             Begin TextBox txtFieldVal 
  307.                Height          =   285
  308.                Index           =   1
  309.                Left            =   2130
  310.                TabIndex        =   40
  311.                Top             =   345
  312.                Width           =   4275
  313.             End
  314.             Begin TextBox txtFieldVal 
  315.                Height          =   285
  316.                Index           =   0
  317.                Left            =   2130
  318.                MaxLength       =   50
  319.                TabIndex        =   28
  320.                Top             =   30
  321.                Width           =   4275
  322.             End
  323.             Begin Label lblFieldName 
  324.                BackStyle       =   0  'Transparent
  325.                FontBold        =   0   'False
  326.                FontItalic      =   0   'False
  327.                FontName        =   "MS Sans Serif"
  328.                FontSize        =   9.75
  329.                FontStrikethru  =   0   'False
  330.                FontUnderline   =   0   'False
  331.                Height          =   255
  332.                Index           =   10
  333.                Left            =   90
  334.                TabIndex        =   39
  335.                Top             =   3180
  336.                Width           =   1965
  337.             End
  338.             Begin Label lblFieldName 
  339.                BackStyle       =   0  'Transparent
  340.                FontBold        =   0   'False
  341.                FontItalic      =   0   'False
  342.                FontName        =   "MS Sans Serif"
  343.                FontSize        =   9.75
  344.                FontStrikethru  =   0   'False
  345.                FontUnderline   =   0   'False
  346.                Height          =   255
  347.                Index           =   9
  348.                Left            =   90
  349.                TabIndex        =   38
  350.                Top             =   2865
  351.                Width           =   1965
  352.             End
  353.             Begin Label lblFieldName 
  354.                BackStyle       =   0  'Transparent
  355.                FontBold        =   0   'False
  356.                FontItalic      =   0   'False
  357.                FontName        =   "MS Sans Serif"
  358.                FontSize        =   9.75
  359.                FontStrikethru  =   0   'False
  360.                FontUnderline   =   0   'False
  361.                Height          =   255
  362.                Index           =   8
  363.                Left            =   90
  364.                TabIndex        =   37
  365.                Top             =   2550
  366.                Width           =   1965
  367.             End
  368.             Begin Label lblFieldName 
  369.                BackStyle       =   0  'Transparent
  370.                FontBold        =   0   'False
  371.                FontItalic      =   0   'False
  372.                FontName        =   "MS Sans Serif"
  373.                FontSize        =   9.75
  374.                FontStrikethru  =   0   'False
  375.                FontUnderline   =   0   'False
  376.                Height          =   255
  377.                Index           =   7
  378.                Left            =   90
  379.                TabIndex        =   36
  380.                Top             =   2235
  381.                Width           =   1965
  382.             End
  383.             Begin Label lblFieldName 
  384.                BackStyle       =   0  'Transparent
  385.                FontBold        =   0   'False
  386.                FontItalic      =   0   'False
  387.                FontName        =   "MS Sans Serif"
  388.                FontSize        =   9.75
  389.                FontStrikethru  =   0   'False
  390.                FontUnderline   =   0   'False
  391.                Height          =   255
  392.                Index           =   6
  393.                Left            =   90
  394.                TabIndex        =   35
  395.                Top             =   1920
  396.                Width           =   1965
  397.             End
  398.             Begin Label lblFieldName 
  399.                BackStyle       =   0  'Transparent
  400.                FontBold        =   0   'False
  401.                FontItalic      =   0   'False
  402.                FontName        =   "MS Sans Serif"
  403.                FontSize        =   9.75
  404.                FontStrikethru  =   0   'False
  405.                FontUnderline   =   0   'False
  406.                Height          =   255
  407.                Index           =   5
  408.                Left            =   90
  409.                TabIndex        =   34
  410.                Top             =   1605
  411.                Width           =   1965
  412.             End
  413.             Begin Label lblFieldName 
  414.                BackStyle       =   0  'Transparent
  415.                FontBold        =   0   'False
  416.                FontItalic      =   0   'False
  417.                FontName        =   "MS Sans Serif"
  418.                FontSize        =   9.75
  419.                FontStrikethru  =   0   'False
  420.                FontUnderline   =   0   'False
  421.                Height          =   255
  422.                Index           =   4
  423.                Left            =   90
  424.                TabIndex        =   33
  425.                Top             =   1290
  426.                Width           =   1965
  427.             End
  428.             Begin Label lblFieldName 
  429.                BackStyle       =   0  'Transparent
  430.                FontBold        =   0   'False
  431.                FontItalic      =   0   'False
  432.                FontName        =   "MS Sans Serif"
  433.                FontSize        =   9.75
  434.                FontStrikethru  =   0   'False
  435.                FontUnderline   =   0   'False
  436.                Height          =   255
  437.                Index           =   3
  438.                Left            =   90
  439.                TabIndex        =   32
  440.                Top             =   975
  441.                Width           =   1965
  442.             End
  443.             Begin Label lblFieldName 
  444.                BackStyle       =   0  'Transparent
  445.                FontBold        =   0   'False
  446.                FontItalic      =   0   'False
  447.                FontName        =   "MS Sans Serif"
  448.                FontSize        =   9.75
  449.                FontStrikethru  =   0   'False
  450.                FontUnderline   =   0   'False
  451.                Height          =   255
  452.                Index           =   2
  453.                Left            =   90
  454.                TabIndex        =   31
  455.                Top             =   660
  456.                Width           =   1965
  457.             End
  458.             Begin Label lblFieldName 
  459.                BackStyle       =   0  'Transparent
  460.                FontBold        =   0   'False
  461.                FontItalic      =   0   'False
  462.                FontName        =   "MS Sans Serif"
  463.                FontSize        =   9.75
  464.                FontStrikethru  =   0   'False
  465.                FontUnderline   =   0   'False
  466.                Height          =   255
  467.                Index           =   1
  468.                Left            =   90
  469.                TabIndex        =   30
  470.                Top             =   345
  471.                Width           =   1965
  472.             End
  473.             Begin Label lblFieldName 
  474.                BackStyle       =   0  'Transparent
  475.                FontBold        =   0   'False
  476.                FontItalic      =   0   'False
  477.                FontName        =   "MS Sans Serif"
  478.                FontSize        =   9.75
  479.                FontStrikethru  =   0   'False
  480.                FontUnderline   =   0   'False
  481.                Height          =   255
  482.                Index           =   0
  483.                Left            =   90
  484.                TabIndex        =   29
  485.                Top             =   60
  486.                Width           =   1965
  487.             End
  488.          End
  489.       End
  490.       Begin SSPanel pnlVCRButtons 
  491.          BackColor       =   &H00C0C0C0&
  492.          BevelInner      =   1  'Inset
  493.          Font3D          =   0  'None
  494.          Height          =   1125
  495.          Left            =   240
  496.          TabIndex        =   19
  497.          Top             =   510
  498.          Width           =   6735
  499.          Begin SSPanel pnlFindText 
  500.             Alignment       =   6  'Center - TOP
  501.             BackColor       =   &H00C0C0C0&
  502.             BevelInner      =   1  'Inset
  503.             Font3D          =   2  'Raised w/heavy shading
  504.             ForeColor       =   &H00FF0000&
  505.             Height          =   945
  506.             Left            =   2130
  507.             TabIndex        =   22
  508.             Top             =   90
  509.             Width           =   2475
  510.             Begin SSCommand cmdVCRSeek 
  511.                Enabled         =   0   'False
  512.                Font3D          =   0  'None
  513.                Height          =   495
  514.                Left            =   90
  515.                Outline         =   0   'False
  516.                Picture         =   SAM4MAIN.FRX:0F0A
  517.                TabIndex        =   9
  518.                Top             =   360
  519.                Width           =   2295
  520.             End
  521.             Begin TextBox txtFind 
  522.                Enabled         =   0   'False
  523.                Height          =   285
  524.                Left            =   90
  525.                TabIndex        =   8
  526.                Top             =   60
  527.                Width           =   2295
  528.             End
  529.          End
  530.          Begin SSCommand cmdVCRLast 
  531.             Enabled         =   0   'False
  532.             Font3D          =   0  'None
  533.             Height          =   945
  534.             Left            =   5640
  535.             Outline         =   0   'False
  536.             Picture         =   SAM4MAIN.FRX:120C
  537.             TabIndex        =   11
  538.             Top             =   90
  539.             Width           =   1005
  540.          End
  541.          Begin SSCommand cmdVCRRight 
  542.             Enabled         =   0   'False
  543.             Font3D          =   0  'None
  544.             Height          =   945
  545.             Left            =   4620
  546.             Outline         =   0   'False
  547.             Picture         =   SAM4MAIN.FRX:150E
  548.             TabIndex        =   10
  549.             Top             =   90
  550.             Width           =   1020
  551.          End
  552.          Begin SSCommand cmdVCRLeft 
  553.             Enabled         =   0   'False
  554.             Font3D          =   0  'None
  555.             Height          =   945
  556.             Left            =   1080
  557.             Outline         =   0   'False
  558.             Picture         =   SAM4MAIN.FRX:1810
  559.             TabIndex        =   7
  560.             Top             =   90
  561.             Width           =   1035
  562.          End
  563.          Begin SSCommand cmdVCRFirst 
  564.             Enabled         =   0   'False
  565.             Font3D          =   0  'None
  566.             Height          =   945
  567.             Left            =   90
  568.             Outline         =   0   'False
  569.             Picture         =   SAM4MAIN.FRX:1B12
  570.             TabIndex        =   6
  571.             Top             =   90
  572.             Width           =   990
  573.          End
  574.       End
  575.       Begin Image imgVCRSeek 
  576.          Height          =   480
  577.          Left            =   0
  578.          Picture         =   SAM4MAIN.FRX:1E14
  579.          Top             =   0
  580.          Visible         =   0   'False
  581.          Width           =   480
  582.       End
  583.       Begin Image imgVCRRight 
  584.          Height          =   480
  585.          Left            =   0
  586.          Picture         =   SAM4MAIN.FRX:2116
  587.          Top             =   0
  588.          Visible         =   0   'False
  589.          Width           =   480
  590.       End
  591.       Begin Image imgVCRLeft 
  592.          Height          =   480
  593.          Left            =   0
  594.          Picture         =   SAM4MAIN.FRX:2418
  595.          Top             =   0
  596.          Visible         =   0   'False
  597.          Width           =   480
  598.       End
  599.       Begin Image imgVCRLast 
  600.          Height          =   480
  601.          Left            =   0
  602.          Picture         =   SAM4MAIN.FRX:271A
  603.          Top             =   0
  604.          Visible         =   0   'False
  605.          Width           =   480
  606.       End
  607.       Begin Image imgVCRFirst 
  608.          Height          =   480
  609.          Left            =   0
  610.          Picture         =   SAM4MAIN.FRX:2A1C
  611.          Top             =   0
  612.          Visible         =   0   'False
  613.          Width           =   480
  614.       End
  615.       Begin Image imgUpdateRec 
  616.          Height          =   480
  617.          Left            =   0
  618.          Picture         =   SAM4MAIN.FRX:2D1E
  619.          Top             =   0
  620.          Visible         =   0   'False
  621.          Width           =   480
  622.       End
  623.       Begin Image imgDeleteRec 
  624.          Height          =   480
  625.          Left            =   0
  626.          Picture         =   SAM4MAIN.FRX:3020
  627.          Top             =   0
  628.          Visible         =   0   'False
  629.          Width           =   480
  630.       End
  631.       Begin Image imgAddRec 
  632.          Height          =   480
  633.          Left            =   0
  634.          Picture         =   SAM4MAIN.FRX:3322
  635.          Top             =   0
  636.          Visible         =   0   'False
  637.          Width           =   480
  638.       End
  639.       Begin Image imgClearDisplay 
  640.          Height          =   480
  641.          Left            =   0
  642.          Picture         =   SAM4MAIN.FRX:3624
  643.          Top             =   0
  644.          Visible         =   0   'False
  645.          Width           =   480
  646.       End
  647.       Begin Image imgExport 
  648.          Height          =   480
  649.          Left            =   0
  650.          Picture         =   SAM4MAIN.FRX:3926
  651.          Top             =   0
  652.          Visible         =   0   'False
  653.          Width           =   480
  654.       End
  655.       Begin Image imgRenameFields 
  656.          Height          =   480
  657.          Left            =   0
  658.          Picture         =   SAM4MAIN.FRX:3C28
  659.          Top             =   0
  660.          Visible         =   0   'False
  661.          Width           =   480
  662.       End
  663.       Begin Image imgInfo 
  664.          Height          =   480
  665.          Left            =   0
  666.          Picture         =   SAM4MAIN.FRX:3F2A
  667.          Top             =   0
  668.          Visible         =   0   'False
  669.          Width           =   480
  670.       End
  671.    End
  672.    Begin SSPanel pnlMainButtons 
  673.       Align           =   1  'Align Top
  674.       BackColor       =   &H00C0C0C0&
  675.       BevelInner      =   1  'Inset
  676.       Font3D          =   0  'None
  677.       Height          =   1065
  678.       Left            =   0
  679.       TabIndex        =   17
  680.       Top             =   0
  681.       Width           =   9270
  682.       Begin SSCommand cmdInfo 
  683.          Caption         =   "Dataset Info..."
  684.          Enabled         =   0   'False
  685.          Font3D          =   0  'None
  686.          FontBold        =   0   'False
  687.          FontItalic      =   0   'False
  688.          FontName        =   "MS Sans Serif"
  689.          FontSize        =   8.25
  690.          FontStrikethru  =   0   'False
  691.          FontUnderline   =   0   'False
  692.          Height          =   885
  693.          Left            =   1590
  694.          Outline         =   0   'False
  695.          Picture         =   SAM4MAIN.FRX:422C
  696.          TabIndex        =   1
  697.          Top             =   90
  698.          Width           =   1530
  699.       End
  700.       Begin SSCommand cmdRenameFields 
  701.          Caption         =   "Rename Fields..."
  702.          Enabled         =   0   'False
  703.          Font3D          =   0  'None
  704.          FontBold        =   0   'False
  705.          FontItalic      =   0   'False
  706.          FontName        =   "MS Sans Serif"
  707.          FontSize        =   8.25
  708.          FontStrikethru  =   0   'False
  709.          FontUnderline   =   0   'False
  710.          Height          =   885
  711.          Left            =   3120
  712.          Outline         =   0   'False
  713.          Picture         =   SAM4MAIN.FRX:452E
  714.          TabIndex        =   2
  715.          Top             =   90
  716.          Width           =   1530
  717.       End
  718.       Begin SSCommand cmdExit 
  719.          Caption         =   "Exit"
  720.          Font3D          =   0  'None
  721.          FontBold        =   0   'False
  722.          FontItalic      =   0   'False
  723.          FontName        =   "MS Sans Serif"
  724.          FontSize        =   8.25
  725.          FontStrikethru  =   0   'False
  726.          FontUnderline   =   0   'False
  727.          Height          =   885
  728.          Left            =   7710
  729.          Outline         =   0   'False
  730.          Picture         =   SAM4MAIN.FRX:4830
  731.          TabIndex        =   5
  732.          Top             =   90
  733.          Width           =   1470
  734.       End
  735.       Begin SSCommand cmdHelp 
  736.          Caption         =   "Help"
  737.          Font3D          =   0  'None
  738.          FontBold        =   0   'False
  739.          FontItalic      =   0   'False
  740.          FontName        =   "MS Sans Serif"
  741.          FontSize        =   8.25
  742.          FontStrikethru  =   0   'False
  743.          FontUnderline   =   0   'False
  744.          Height          =   885
  745.          Left            =   6180
  746.          Outline         =   0   'False
  747.          Picture         =   SAM4MAIN.FRX:4B32
  748.          TabIndex        =   4
  749.          Top             =   90
  750.          Width           =   1530
  751.       End
  752.       Begin SSCommand cmdExport 
  753.          Caption         =   "Export to .CSV..."
  754.          Enabled         =   0   'False
  755.          Font3D          =   0  'None
  756.          FontBold        =   0   'False
  757.          FontItalic      =   0   'False
  758.          FontName        =   "MS Sans Serif"
  759.          FontSize        =   8.25
  760.          FontStrikethru  =   0   'False
  761.          FontUnderline   =   0   'False
  762.          Height          =   885
  763.          Left            =   4650
  764.          Outline         =   0   'False
  765.          Picture         =   SAM4MAIN.FRX:4E34
  766.          TabIndex        =   3
  767.          Top             =   90
  768.          Width           =   1530
  769.       End
  770.       Begin SSCommand cmdOpen 
  771.          Caption         =   "Open..."
  772.          Font3D          =   0  'None
  773.          FontBold        =   0   'False
  774.          FontItalic      =   0   'False
  775.          FontName        =   "MS Sans Serif"
  776.          FontSize        =   8.25
  777.          FontStrikethru  =   0   'False
  778.          FontUnderline   =   0   'False
  779.          Height          =   885
  780.          Left            =   90
  781.          Outline         =   0   'False
  782.          Picture         =   SAM4MAIN.FRX:5136
  783.          TabIndex        =   0
  784.          Top             =   90
  785.          Width           =   1500
  786.       End
  787.    End
  788.    Begin Image imgDVCRSeek 
  789.       Height          =   480
  790.       Left            =   0
  791.       Picture         =   SAM4MAIN.FRX:5438
  792.       Top             =   0
  793.       Visible         =   0   'False
  794.       Width           =   480
  795.    End
  796.    Begin Image imgDVCRRight 
  797.       Height          =   480
  798.       Left            =   0
  799.       Picture         =   SAM4MAIN.FRX:573A
  800.       Top             =   0
  801.       Visible         =   0   'False
  802.       Width           =   480
  803.    End
  804.    Begin Image imgDVCRLeft 
  805.       Height          =   480
  806.       Left            =   0
  807.       Picture         =   SAM4MAIN.FRX:5A3C
  808.       Top             =   0
  809.       Visible         =   0   'False
  810.       Width           =   480
  811.    End
  812.    Begin Image imgDVCRLast 
  813.       Height          =   480
  814.       Left            =   0
  815.       Picture         =   SAM4MAIN.FRX:5D3E
  816.       Top             =   0
  817.       Visible         =   0   'False
  818.       Width           =   480
  819.    End
  820.    Begin Image imgDVCRFirst 
  821.       Height          =   480
  822.       Left            =   0
  823.       Picture         =   SAM4MAIN.FRX:6040
  824.       Top             =   0
  825.       Visible         =   0   'False
  826.       Width           =   480
  827.    End
  828.    Begin Image imgDExport 
  829.       Height          =   480
  830.       Left            =   0
  831.       Picture         =   SAM4MAIN.FRX:6342
  832.       Top             =   0
  833.       Visible         =   0   'False
  834.       Width           =   480
  835.    End
  836.    Begin Image imgDRenameFields 
  837.       Height          =   480
  838.       Left            =   0
  839.       Picture         =   SAM4MAIN.FRX:6644
  840.       Top             =   0
  841.       Visible         =   0   'False
  842.       Width           =   480
  843.    End
  844.    Begin Image imgDInfo 
  845.       Height          =   480
  846.       Left            =   0
  847.       Picture         =   SAM4MAIN.FRX:6946
  848.       Top             =   0
  849.       Visible         =   0   'False
  850.       Width           =   480
  851.    End
  852.    Begin Image imgDClearDisplay 
  853.       Height          =   480
  854.       Left            =   0
  855.       Picture         =   SAM4MAIN.FRX:6C48
  856.       Top             =   0
  857.       Visible         =   0   'False
  858.       Width           =   480
  859.    End
  860.    Begin Image imgDUpdateRec 
  861.       Height          =   480
  862.       Left            =   0
  863.       Picture         =   SAM4MAIN.FRX:6F4A
  864.       Top             =   0
  865.       Visible         =   0   'False
  866.       Width           =   480
  867.    End
  868.    Begin Image imgDDeleteRec 
  869.       Height          =   480
  870.       Left            =   0
  871.       Picture         =   SAM4MAIN.FRX:724C
  872.       Top             =   0
  873.       Visible         =   0   'False
  874.       Width           =   480
  875.    End
  876.    Begin Image imgDAddRec 
  877.       Height          =   480
  878.       Left            =   0
  879.       Picture         =   SAM4MAIN.FRX:754E
  880.       Top             =   0
  881.       Visible         =   0   'False
  882.       Width           =   480
  883.    End
  884. Option Explicit
  885. Sub AssembleRecord ()
  886.     PrimaryKey = DisplayedPrimaryKey
  887.     RecordBuffer.Description = txtFieldVal(1).Text
  888.     RecordBuffer.ProductCategory = txtFieldVal(2).Text
  889.     RecordBuffer.FileType = txtFieldVal(3).Text
  890.     RecordBuffer.BasePrice = Val(US_StripOut((txtFieldVal(4).Text), ",$"))  'The VAL function stops on "$" and "," chars.
  891.     RecordBuffer.PricingNotes = txtFieldVal(5).Text
  892.     RecordBuffer.CatalogPage = Format$(Val(txtFieldVal(6).Text), "000")
  893.     RecordBuffer.CompanyName = txtFieldVal(7).Text
  894.     RecordBuffer.Phone = txtFieldVal(8).Text
  895.     RecordBuffer.Fax = txtFieldVal(9).Text
  896.     RecordBuffer.Comments = txtFieldVal(10).Text
  897. End Sub
  898. Sub cboIndex_Click ()
  899.     If cboIndex.ListIndex <> LastIndexListIndex Then    'change
  900.         txtFieldVal(CurrentIndex).BackColor = WHITE
  901.         LastIndexListIndex = cboIndex.ListIndex
  902.         CurrentIndex = Val(Left$(cboIndex.List(cboIndex.ListIndex), 3))
  903.         txtFieldVal(CurrentIndex).BackColor = BLUE
  904.         
  905.         'Restrict search argument length for this index:
  906.         If CurrentIndex = 0 Then
  907.             txtFind.MaxLength = DatasetInfo.MaxPrimaryKeyLen
  908.         Else
  909.             txtFind.MaxLength = Val(US_LeaveOnly(FieldType(CurrentIndex), "0123456789"))
  910.         End If
  911.         '(re)enable VCR controls in case we were at BOF/EOF in the previously selected index.
  912.         cmdVCRLast.Enabled = True
  913.         cmdVCRLast.Picture = imgVCRLast.Picture
  914.         cmdVCRRight.Enabled = True
  915.         cmdVCRRight.Picture = imgVCRRight.Picture
  916.         cmdVCRFirst.Enabled = True
  917.         cmdVCRFirst.Picture = imgVCRFirst.Picture
  918.         cmdVCRLeft.Enabled = True
  919.         cmdVCRLeft.Picture = imgVCRLeft.Picture
  920.         'Leave the display alone, but set the index pointer in the new index to this record,
  921.         'so that the VCR movements will start at this record in the newly-selected index.
  922.         'To illustrate: Suppose we were dealing with an employee file, browsing though the
  923.         'employee-name index; if we're looking at Mr. Zugman of the aardvark-processing
  924.         'department, and switch to the department index, we want to be in the right place.
  925.         'Remember, each index threads a file of records in a different sequence, and VB/ISAM
  926.         'maintains separate pointers for each index.
  927.         RefindRecord
  928.     End If
  929. End Sub
  930. Sub cmdAddRec_Click ()
  931.     txtFind.Text = ""
  932.     DisplayedPrimaryKey = US_Trim((txtFieldVal(0).Text))
  933.     If DisplayedPrimaryKey = "" Then
  934.         TellUser (NULL_PRIMARY_KEY)
  935.     ElseIf DisplayedPrimaryKey = PrimaryKey Then
  936.         TellUser (CANNOT_READD_SAME_RECORD)
  937.     Else
  938.         AssembleRecord
  939.         rc = VmxPut(DatasetRefNum, PrimaryKey, RecordBuffer, ADD_ONLY)
  940.         If rc = VIS_UPDATE_VIOLATION Then
  941.             TellUser (RECORD_ALREADY_EXISTS)
  942.         ElseIf rc <> VIS_OK Then
  943.             TellUser (PUTERROR)
  944.             ExitProgram  'Panic exit
  945.         Else    'VIS_OK
  946.             FlashDisplay
  947.             ClearOrRestoreToggle = 0
  948.             ChangeAlertFlag = False
  949.             cmdVCRLast.Enabled = True
  950.             cmdVCRLast.Picture = imgVCRLast.Picture
  951.             cmdVCRRight.Enabled = True
  952.             cmdVCRRight.Picture = imgVCRRight.Picture
  953.             cmdVCRFirst.Enabled = True
  954.             cmdVCRFirst.Picture = imgVCRFirst.Picture
  955.             cmdVCRLeft.Enabled = True
  956.             cmdVCRLeft.Picture = imgVCRLeft.Picture
  957.         End If
  958.     End If
  959. End Sub
  960. Sub cmdClearDisplay_Click ()
  961.     Dim I As Integer
  962.     If ClearOrRestoreToggle = 0 Then  'Clear display
  963.         SuppressChangeEventFlag = True
  964.         For I = 0 To NumberOfFields
  965.             txtFieldVal(I).Text = ""
  966.         Next I
  967.         SuppressChangeEventFlag = False
  968.         ChangeAlertFlag = False
  969.         ClearOrRestoreToggle = 1
  970.     Else    'Restore original data to display
  971.         DisplayCurrentRecord    'Note, that routine will set toggle to 0
  972.     End If
  973. End Sub
  974. Sub cmdDeleteRec_Click ()
  975.     txtFind.Text = ""
  976.     If PrimaryKey <> "" Then
  977.         DisplayedPrimaryKey = US_Trim((txtFieldVal(0).Text))
  978.         If DisplayedPrimaryKey <> PrimaryKey Then
  979.             TellUser (MUST_RESTORE_PRIMARY_KEY)
  980.         Else
  981.             rc = VmxDelete(DatasetRefNum, PrimaryKey)
  982.             If rc <> VIS_OK Then
  983.                 TellUser (DELETEERROR)
  984.                 ExitProgram
  985.             Else
  986.                 ClearOrRestoreToggle = 0
  987.                 cmdClearDisplay_Click
  988.                 SavedPrimaryKey = PrimaryKey    'needed for RefindRecord procedure
  989.                 PrimaryKey = ""
  990.                 FlashDisplay
  991.                 ChangeAlertFlag = False
  992.             End If
  993.         End If
  994.     End If
  995. End Sub
  996. Sub cmdExit_Click ()
  997.     If ChangeAlertFlag = True Then
  998.         rc = DiscardChangesQuery()
  999.         If rc = IDOK Then
  1000.             ChangeAlertFlag = False
  1001.         Else
  1002.             Exit Sub
  1003.         End If
  1004.     End If
  1005.     ExitProgram
  1006. End Sub
  1007. Sub cmdExport_Click ()
  1008.     Dim L, T As Integer
  1009.     Dim SavePrimaryKey As String
  1010.     txtFind.Text = ""
  1011. 'Invoke the common-dialog
  1012.     cdbExport.DialogTitle = "Create/select a .CSV file for export"
  1013.     cdbExport.Filename = "*.csv"
  1014.     'Set flags for common dialog control:
  1015.     '   File must not be read-only
  1016.     '   Path must be valid; also,
  1017.     '   Hide "read-only" check box
  1018.     '   Prompt for overwrite
  1019.     cdbExport.Flags = &H8000& Or &H800& Or &H4& Or &H2&
  1020.     On Error GoTo DontOpen
  1021.     cdbExport.Action = DLG_FILE_SAVE    'Select filename
  1022.     ExportFileName = cdbExport.Filename
  1023.     If Right$(ExportFileName, 4) <> ".CSV" Then
  1024.         TellUser (NOT_A_CSV_FILE)
  1025.         Error 32755 'Simulate user pressing "Cancel" button
  1026.     End If
  1027.     'We have a filename; open it:
  1028.     ExportFileNum = FreeFile
  1029.     Open ExportFileName For Binary Access Write As #ExportFileNum
  1030.     If LOF(ExportFileNum) > 0 Then
  1031.         Close #ExportFileNum
  1032.         Kill ExportFileName
  1033.         ExportFileNum = FreeFile
  1034.         Open ExportFileName For Binary Access Write As #ExportFileNum
  1035.     End If
  1036.     On Error GoTo 0
  1037. 'Save current position in primary index (to be restored when we return from export)
  1038.     rc = VmxGet(DatasetRefNum, 0, XCURRENT + XNO_DATA, "", Throwaway, SavePrimaryKey, Throwaway)
  1039. 'Center frmExport form left/right over frmMainForm, down a bit:
  1040.     T = Me.Top + 660
  1041.     L = Me.Left + (Me.Width / 2) - (frmExport.Width / 2)
  1042.     frmExport.Move L, T
  1043. 'Let the Form_Activate procedure in frmExport take over:
  1044.     frmExport!pnlGauge.FloodPercent = 0
  1045.     frmExport.Show MODAL
  1046. 'Returned from frmExport; restore position in primary index:
  1047.     rc = VmxGet(DatasetRefNum, 0, XLOOKUP + XNO_DATA, SavePrimaryKey, Throwaway, Throwaway, Throwaway)
  1048. 'Done
  1049.     Exit Sub
  1050. DontOpen:
  1051.     Resume CancelExport
  1052. CancelExport:
  1053.     On Error GoTo 0
  1054.     Exit Sub
  1055. End Sub
  1056. Sub cmdHelp_Click ()
  1057.     Dim L, T As Integer
  1058.     txtFind.Text = ""
  1059. 'Center frmHelp form over frmMainForm:
  1060.     T = Me.Top + (Me.Height / 2) - (frmHelp.Height / 2)
  1061.     L = Me.Left + (Me.Width / 2) - (frmHelp.Width / 2)
  1062.     frmHelp.Move L, T
  1063.     frmHelp.Show MODAL
  1064. End Sub
  1065. Sub cmdInfo_Click ()
  1066.     Dim L, T As Integer
  1067.     txtFind.Text = ""
  1068. 'Center frmInfo form over frmMainForm:
  1069.     T = Me.Top + (Me.Height / 2) - (frmInfo.Height / 2)
  1070.     L = Me.Left + (Me.Width / 2) - (frmInfo.Width / 2)
  1071.     frmInfo.Move L, T
  1072.     frmInfo.Show MODAL
  1073. End Sub
  1074. Sub cmdOpen_Click ()
  1075. 'This procedure has been hard-wired to open the dataset "c:\vbprod"
  1076.     txtFind.Text = ""
  1077.     If ChangeAlertFlag = True Then
  1078.         rc = DiscardChangesQuery()
  1079.         If rc = IDOK Then
  1080.             ChangeAlertFlag = False
  1081.         Else
  1082.             Exit Sub
  1083.         End If
  1084.     End If
  1085. 'If a dataset is already open, close it and reset the form:
  1086.     If DatasetRefNum <> 0 Then
  1087.         ResetForm
  1088.         rc = VmxClose(DatasetRefNum)
  1089.         If rc <> VIS_OK Then
  1090.             TellUser (CLOSE_ERROR)
  1091.             ExitProgram  'Panic exit
  1092.         End If
  1093.         DatasetRefNum = 0   'In case the user cancels out...
  1094.     End If
  1095. 'Announce the hard-wired open, ask for READ_ONLY or READ_WRITE:
  1096.     MBType = MB_ICONINFORMATION + MB_YESNOCANCEL
  1097.     Msg = "This sample/demonstration program is " & Chr$(34) & "hardwired" & Chr$(34) & " to work only with one specific dataset; "
  1098.     Msg = Msg & "it expects to find the " & Chr$(34) & "VBPROD" & Chr$(34) & " dataset (i.e., the three files VBPROD.ISD, "
  1099.     Msg = Msg & "VBPROD.ISM, and VBPROD.ISF, plus the optional schema file VBPROD.ISS) in  "
  1100.     Msg = Msg & "the C:\ directory." & CRLFDelim & CRLFDelim
  1101.     Msg = Msg & "Note that the " & Chr$(34) & "real" & Chr$(34)
  1102.     Msg = Msg & " version of VB/ISAM Data Editor can open any VB/ISAM dataset with up to 99 fields in its record format."
  1103.     Msg = Msg & CRLFDelim & CRLFDelim
  1104.     Msg = Msg & "VBPROD is a summary of the VB add-on product listings in the Winter/Spring 1994 "
  1105.     Msg = Msg & Chr$(34) & "Component Objects and Companion Products for Visual Basic
  1106.  Programming System for Windows[TM]" & Chr$(34)
  1107.     Msg = Msg & " catalog, published by Fawcette Technical Publications for Microsoft Corporation.  "
  1108.     Msg = Msg & "(Some fields, including company phone numbers, have been left "
  1109.     Msg = Msg & "blank for you to fill in.)" & CRLFDelim & CRLFDelim
  1110.     Msg = Msg & "The author of this program takes responsibility for all errors and omissions, "
  1111.     Msg = Msg & "and for the content of the " & Chr$(34) & "description" & Chr$(34) & " fields.  "
  1112.     Msg = Msg & "All product names may be assumed to be trademarks or registered trademarks.  "
  1113.     Msg = Msg & "All trademarks and copyrights are the properties of their respective owners."
  1114.     Msg = Msg & CRLFDelim & CRLFDelim
  1115.     Msg = Msg & "Do you want read-write access?  (NO --> read-only)"
  1116.     rc = MsgBox(Msg, MBType, MBTitle)
  1117.     Select Case rc
  1118.     Case IDYES
  1119.         DatasetAccessMode = READ_WRITE
  1120.     Case IDNO
  1121.         DatasetAccessMode = READ_ONLY
  1122.     Case Else   'User clicked CANCEL
  1123.         Exit Sub
  1124.     End Select
  1125. 'Open the dataset:
  1126.     rc = VmxOpen("c:\vbprod", DatasetRefNum) 'DEMO VERSION OF DLL (no access-mode choice; always exclusive read-write)
  1127.     If rc <> VIS_OK Then
  1128.         If rc = VIS_ACCESS_DENIED Then
  1129.             TellUser (ACCESS_DENIED)
  1130.         Else
  1131.             TellUser (OPEN_ERROR)
  1132.         End If
  1133.         Exit Sub
  1134.     End If
  1135. 'Get dataset info (especially the StandardFormat string, which gives the record format):
  1136.     rc = VMXInfo(DatasetRefNum, DatasetInfo)
  1137.     If rc <> VIS_OK Then
  1138.         TellUser (INFO_ERROR)
  1139.         ExitProgram 'Panic exit
  1140.     End If
  1141.     pnlDatasetName.Caption = "Dataset name:  C:\VBPROD"
  1142. 'Hard-wire the FieldType array:
  1143.     NumberOfFields = 10
  1144.     FieldType(0) = "P$*50"  '(primary key) Product name
  1145.     FieldType(1) = "$"      'Description
  1146.     FieldType(2) = "X45$"   'Product category
  1147.     FieldType(3) = "X$*3"   'File type
  1148.     FieldType(4) = "@"      'Base price
  1149.     FieldType(5) = "$"      'Pricing notes
  1150.     FieldType(6) = "X$*3"   'Catalog page
  1151.     FieldType(7) = "X35$"   'Company name
  1152.     FieldType(8) = "$"      'Phone
  1153.     FieldType(9) = "$"      'Fax
  1154.     FieldType(10) = "$"     'Comments
  1155.     EnableControls
  1156. 'See if the dataset is accompanied by a .ISS ("Schema") file, containing field names:
  1157.     SchemaFileName = "c:\vbprod.iss"
  1158.     SchemaFileNum = FreeFile
  1159.     On Error GoTo CannotCreateSchemaFile
  1160.     Open SchemaFileName For Binary As #SchemaFileNum
  1161.     On Error GoTo 0
  1162.     SchemaFileAccessibleFlag = True
  1163.     'Get schema:
  1164.     If LOF(SchemaFileNum) = 0 Then  'If we just created an empty schema file, we'll have to initialize it:
  1165.         InitSchema  'See this sub for schema-file format info.
  1166.     Else
  1167.         'Read schema file:
  1168.         SchemaFileContents = Input$(LOF(SchemaFileNum), #SchemaFileNum)
  1169.         'Break contents of .ISS file into comment section and schema section:
  1170.         SchemaCommentHeader = DS_GetField(SchemaFileContents, "[BEGIN SCHEMA]", 1)
  1171.         Schema = DS_GetField(SchemaFileContents, "[BEGIN SCHEMA]", 2)
  1172.         'Strip off the CRLF (perhaps preceded by improper spaces) at the end of the "[BEGIN SCHEMA]" line:
  1173.         Schema = DS_RemoveField(Schema, CRLFDelim, 1)
  1174.     End If
  1175.     Close #SchemaFileNum
  1176. 'Use the information in the schema to set up the display:
  1177.     ConfigureDisplay
  1178. 'Done.
  1179.     Exit Sub
  1180. CannotCreateSchemaFile:
  1181.     TellUser (CANT_ACCESS_SCHEMA_FILE)
  1182.     SchemaFileAccessibleFlag = False
  1183.     InitSchema
  1184.     ConfigureDisplay
  1185.     cmdRenameFields.Enabled = False
  1186.     cmdRenameFields.Picture = imgDRenameFields.Picture
  1187.     Resume ExitThisSubroutine
  1188. ExitThisSubroutine:
  1189.     On Error GoTo 0
  1190.     Exit Sub
  1191. End Sub
  1192. Sub cmdRenameFields_Click ()
  1193.     Dim L, T As Integer
  1194.     Dim I As Integer
  1195.     txtFind.Text = ""
  1196. 'Initialize frmRenameFields to display primary key:
  1197.     SchemaLine = DS_GetField(Schema, CRLFDelim, 1)
  1198.     ThisType = DS_GetField(SchemaLine, BarDelim, 2)
  1199.     frmRenameFields!lblFieldNum.Caption = "000 [" & ThisType & "]"
  1200.     frmRenameFields!txtFieldName.Text = DS_GetField(SchemaLine, BarDelim, 3)
  1201. 'Center frmRenameFields form over frmMainForm:
  1202.     T = Me.Top + (Me.Height / 2) - (frmRenameFields.Height / 2)
  1203.     L = Me.Left + (Me.Width / 2) - (frmRenameFields.Width / 2)
  1204.     frmRenameFields.Move L, T
  1205.     FieldNum = 0    'for spin button display
  1206. 'Initialize change-flag and go:
  1207.     SchemaDirtyFlag = False
  1208.     frmRenameFields.Show MODAL
  1209. 'Have returned from frmRenameFields; if schema has changed, update .ISS file and change display:
  1210.     If SchemaDirtyFlag = True Then
  1211.         SchemaDirtyFlag = False
  1212.         SchemaFileNum = FreeFile
  1213.         On Error GoTo CannotOpenSchemaFile
  1214.         Open SchemaFileName For Binary Access Read Write As #SchemaFileNum  'test to see if openable...
  1215.         Close SchemaFileNum
  1216.         Kill SchemaFileName 'Destroy old file, in case new version is shorter.
  1217.         SchemaFileNum = FreeFile
  1218.         Open SchemaFileName For Binary Access Read Write As #SchemaFileNum
  1219.         On Error GoTo 0
  1220.         'Write schema file:
  1221.         SchemaFileContents = SchemaCommentHeader & CRLFDelim & "[BEGIN SCHEMA]" & CRLFDelim & Schema
  1222.         Put #SchemaFileNum, , SchemaFileContents
  1223.         Close #SchemaFileNum
  1224.         'Re-label fields in the display:
  1225.         For I = 0 To NumberOfFields
  1226.             SchemaLine = DS_GetField(Schema, CRLFDelim, I + 1)
  1227.             lblFieldName(I).Caption = DS_GetField(SchemaLine, BarDelim, 1) & "  " & DS_GetField(SchemaLine, BarDelim, 3)
  1228.         Next I
  1229.     End If
  1230.     Exit Sub
  1231. CannotOpenSchemaFile:
  1232.     TellUser (CANT_ACCESS_SCHEMA_FILE)
  1233.     SchemaFileAccessibleFlag = False
  1234.     cmdRenameFields.Enabled = False
  1235.     InitSchema
  1236.     'Re-label fields in the display to correspond to the default schema built in InitSchema:
  1237.     For I = 0 To NumberOfFields
  1238.         SchemaLine = DS_GetField(Schema, CRLFDelim, I + 1)
  1239.         lblFieldName(I).Caption = DS_GetField(SchemaLine, BarDelim, 1) & "  " & DS_GetField(SchemaLine, BarDelim, 3)
  1240.     Next I
  1241.     Resume QuitThisSubroutine
  1242. QuitThisSubroutine:
  1243.     On Error GoTo 0
  1244.     Exit Sub
  1245. End Sub
  1246. Sub cmdUpdateRec_Click ()
  1247.     txtFind.Text = ""
  1248.     If ChangeAlertFlag = False Then
  1249.         TellUser (NOTHING_TO_UPDATE)
  1250.         Exit Sub
  1251.     End If
  1252.     DisplayedPrimaryKey = US_Trim((txtFieldVal(0).Text))
  1253.     If DisplayedPrimaryKey <> PrimaryKey Then
  1254.         TellUser (SHOULD_ADD_NOT_UPDATE)
  1255.     ElseIf PrimaryKey = "" Then
  1256.         TellUser (NULL_PRIMARY_KEY)
  1257.     Else
  1258.         AssembleRecord
  1259.         rc = VmxPut(DatasetRefNum, PrimaryKey, RecordBuffer, REPLACE_ONLY)
  1260.         If rc <> VIS_OK Then
  1261.             TellUser (PUTERROR)
  1262.             ExitProgram  'Panic exit
  1263.         Else    'VIS_OK
  1264.             FlashDisplay
  1265.             ChangeAlertFlag = False
  1266.         End If
  1267.     End If
  1268. End Sub
  1269. Sub cmdVCRFirst_Click ()
  1270.     Dim EmptyFlag As Integer
  1271.     txtFind.Text = ""
  1272.     If ChangeAlertFlag = True Then
  1273.         rc = DiscardChangesQuery()
  1274.         If rc = IDOK Then
  1275.             ChangeAlertFlag = False
  1276.         Else
  1277.             Exit Sub
  1278.         End If
  1279.     End If
  1280.     EmptyFlag = False
  1281.     rc = VmxBOF(DatasetRefNum, CurrentIndex)    'VmxBOF sets an index pointer to just BEFORE the first entry (if any) in that index.
  1282.     If rc <> VIS_OK Then
  1283.         TellUser (BOFERROR)
  1284.         ExitProgram   'Panic exit
  1285.     End If
  1286.     rc = VmxGet(DatasetRefNum, CurrentIndex, XNEXT, "", Throwaway, PrimaryKey, RecordBuffer)
  1287.     If rc = VIS_OK Then
  1288.         DisplayCurrentRecord
  1289.     ElseIf rc = VIS_NOT_FOUND Then
  1290.         TellUser (INDEX_IS_EMPTY)
  1291.         EmptyFlag = True
  1292.     Else
  1293.         TellUser (GETERROR)
  1294.         ExitProgram  'Panic exit
  1295.     End If
  1296.     cmdVCRFirst.Enabled = False
  1297.     cmdVCRFirst.Picture = imgDVCRFirst.Picture
  1298.     cmdVCRLeft.Enabled = False
  1299.     cmdVCRLeft.Picture = imgDVCRLeft.Picture
  1300.     If EmptyFlag = True Then
  1301.         cmdVCRLast.Enabled = False
  1302.         cmdVCRLast.Picture = imgDVCRLast.Picture
  1303.         cmdVCRRight.Enabled = False
  1304.         cmdVCRRight.Picture = imgDVCRRight.Picture
  1305.     Else
  1306.         cmdVCRLast.Enabled = True
  1307.         cmdVCRLast.Picture = imgVCRLast.Picture
  1308.         cmdVCRRight.Enabled = True
  1309.         cmdVCRRight.Picture = imgVCRRight.Picture
  1310.         cmdVCRRight.SetFocus
  1311.     End If
  1312. End Sub
  1313. Sub cmdVCRLast_Click ()
  1314.     Dim EmptyFlag As Integer
  1315.     txtFind.Text = ""
  1316.     txtFind.Text = ""
  1317.     If ChangeAlertFlag = True Then
  1318.         rc = DiscardChangesQuery()
  1319.         If rc = IDOK Then
  1320.             ChangeAlertFlag = False
  1321.         Else
  1322.             Exit Sub
  1323.         End If
  1324.     End If
  1325.     EmptyFlag = False
  1326.     rc = VmxEOF(DatasetRefNum, CurrentIndex)
  1327.     If rc <> VIS_OK Then
  1328.         TellUser (EOFERROR)
  1329.         ExitProgram   'Panic exit
  1330.     End If
  1331.     rc = VmxGet(DatasetRefNum, CurrentIndex, XPREVIOUS, "", Throwaway, PrimaryKey, RecordBuffer)
  1332.     If rc = VIS_OK Then
  1333.         DisplayCurrentRecord
  1334.     ElseIf rc = VIS_NOT_FOUND Then
  1335.         TellUser (INDEX_IS_EMPTY)
  1336.         EmptyFlag = True
  1337.     Else
  1338.         TellUser (GETERROR)
  1339.         ExitProgram  'Panic exit
  1340.     End If
  1341.     cmdVCRLast.Enabled = False
  1342.     cmdVCRLast.Picture = imgDVCRLast.Picture
  1343.     cmdVCRRight.Enabled = False
  1344.     cmdVCRRight.Picture = imgDVCRRight.Picture
  1345.     If EmptyFlag = True Then
  1346.         cmdVCRFirst.Enabled = False
  1347.         cmdVCRFirst.Picture = imgDVCRFirst.Picture
  1348.         cmdVCRLeft.Enabled = False
  1349.         cmdVCRLeft.Picture = imgDVCRLeft.Picture
  1350.     Else
  1351.         cmdVCRFirst.Enabled = True
  1352.         cmdVCRFirst.Picture = imgVCRFirst.Picture
  1353.         cmdVCRLeft.Enabled = True
  1354.         cmdVCRLeft.Picture = imgVCRLeft.Picture
  1355.         cmdVCRLeft.SetFocus
  1356.     End If
  1357.           
  1358. End Sub
  1359. Sub cmdVCRLeft_Click ()
  1360.     txtFind.Text = ""
  1361.     If ChangeAlertFlag = True Then
  1362.         rc = DiscardChangesQuery()
  1363.         If rc = IDOK Then
  1364.             ChangeAlertFlag = False
  1365.         Else
  1366.             Exit Sub
  1367.         End If
  1368.     End If
  1369.     rc = VmxGet(DatasetRefNum, CurrentIndex, XPREVIOUS, "", Throwaway, PrimaryKey, RecordBuffer)
  1370.     If rc = VIS_OK Then
  1371.         DisplayCurrentRecord
  1372.         cmdVCRLast.Enabled = True
  1373.         cmdVCRLast.Picture = imgVCRLast.Picture
  1374.         cmdVCRRight.Enabled = True
  1375.         cmdVCRRight.Picture = imgVCRRight.Picture
  1376.         cmdVCRFirst.Enabled = True
  1377.         cmdVCRFirst.Picture = imgVCRFirst.Picture
  1378.         cmdVCRLeft.Enabled = True
  1379.         cmdVCRLeft.Picture = imgVCRLeft.Picture
  1380.     ElseIf rc = VIS_NOT_FOUND Then  'We're at BOF in this index.
  1381.         cmdVCRFirst_Click   'A bit redundant, but handy.
  1382.     Else
  1383.         TellUser (GETERROR)
  1384.         ExitProgram  'Panic exit
  1385.     End If
  1386. End Sub
  1387. Sub cmdVCRRight_Click ()
  1388.     txtFind.Text = ""
  1389.     If ChangeAlertFlag = True Then
  1390.         rc = DiscardChangesQuery()
  1391.         If rc = IDOK Then
  1392.             ChangeAlertFlag = False
  1393.         Else
  1394.             Exit Sub
  1395.         End If
  1396.     End If
  1397.     rc = VmxGet(DatasetRefNum, CurrentIndex, XNEXT, "", Throwaway, PrimaryKey, RecordBuffer)
  1398.     If rc = VIS_OK Then
  1399.         DisplayCurrentRecord
  1400.         cmdVCRLast.Enabled = True
  1401.         cmdVCRLast.Picture = imgVCRLast.Picture
  1402.         cmdVCRRight.Enabled = True
  1403.         cmdVCRRight.Picture = imgVCRRight.Picture
  1404.         cmdVCRFirst.Enabled = True
  1405.         cmdVCRFirst.Picture = imgVCRFirst.Picture
  1406.         cmdVCRLeft.Enabled = True
  1407.         cmdVCRLeft.Picture = imgVCRLeft.Picture
  1408.     ElseIf rc = VIS_NOT_FOUND Then  'We're at EOF in this index.
  1409.         cmdVCRLast_Click    'A bit redundant, but handy.
  1410.     Else
  1411.         TellUser (GETERROR)
  1412.         ExitProgram  'Panic exit
  1413.     End If
  1414. End Sub
  1415. Sub cmdVCRSeek_Click ()
  1416.     Dim SearchArgument As String
  1417.     If ChangeAlertFlag = True Then
  1418.         rc = DiscardChangesQuery()
  1419.         If rc = IDOK Then
  1420.             ChangeAlertFlag = False
  1421.         Else
  1422.             Exit Sub
  1423.         End If
  1424.     End If
  1425.     SearchArgument = US_Trim((txtFind.Text))
  1426.     If SearchArgument = "" Then
  1427.         TellUser (NO_SEARCH_TEXT)
  1428.     Else
  1429.         If CurrentIndex = 6 Then SearchArgument = Format$(Val(SearchArgument), "000")   'Page number
  1430.         cmdVCRLast.Enabled = True
  1431.         cmdVCRLast.Picture = imgVCRLast.Picture
  1432.         cmdVCRRight.Enabled = True
  1433.         cmdVCRRight.Picture = imgVCRRight.Picture
  1434.         cmdVCRFirst.Enabled = True
  1435.         cmdVCRFirst.Picture = imgVCRFirst.Picture
  1436.         cmdVCRLeft.Enabled = True
  1437.         cmdVCRLeft.Picture = imgVCRLeft.Picture
  1438.         rc = VmxGet(DatasetRefNum, CurrentIndex, XLOOKUP, SearchArgument, Throwaway, PrimaryKey, RecordBuffer)
  1439.         If rc = VIS_OK Then 'exact match!
  1440.             DisplayCurrentRecord
  1441.         ElseIf rc = VIS_NOT_FOUND Then  'No exact match; advance to the next entry:
  1442.             rc = VmxGet(DatasetRefNum, CurrentIndex, XNEXT, "", Throwaway, PrimaryKey, RecordBuffer)
  1443.             If rc = VIS_OK Then
  1444.                 DisplayCurrentRecord
  1445.             ElseIf rc = VIS_NOT_FOUND Then  'at EOF
  1446.                 cmdVCRLast_Click
  1447.             Else    'error
  1448.                 TellUser (GETERROR)
  1449.                 ExitProgram  'Panic exit
  1450.             End If
  1451.         Else    'error
  1452.             TellUser (GETERROR)
  1453.             ExitProgram  'Panic exit
  1454.         End If
  1455.     End If
  1456. End Sub
  1457. Sub ConfigureDisplay ()
  1458.     Dim I As Integer
  1459.     Dim FNum As String
  1460.     Dim FName As String
  1461.     picFieldDisplayArea.Visible = True
  1462.     'Initialize combo box
  1463.     cboIndex.Clear
  1464.     'Place field names into display captions:
  1465.     For I = 0 To NumberOfFields
  1466.         SchemaLine = DS_GetField(Schema, CRLFDelim, I + 1)
  1467.         FNum = DS_GetField(SchemaLine, BarDelim, 1)
  1468.         ThisType = FieldType(I) 'Don't trust the schema file; it's user-editable.
  1469.         FName = DS_GetField(SchemaLine, BarDelim, 3)
  1470.         lblFieldName(I).Caption = FNum & "  " & FName
  1471.         txtFieldVal(I).TabIndex = txtFieldVal(0).TabIndex + I
  1472.         'If this is an index field, add a line to the (sorted) combo box:
  1473.         If (I = 0) Or (Left$(ThisType, 1) = "X") Then cboIndex.AddItem FNum & " " & FName
  1474.     Next I
  1475.     'Init index selection combo box:
  1476.     LastIndexListIndex = 0  'to avoid triggering a change event.
  1477.     cboIndex.ListIndex = 0  'Init to primary key
  1478.     txtFieldVal(0).BackColor = BLUE
  1479.     CurrentIndex = 0
  1480. '    'Init display with first record in primary index sequence:
  1481. '    cmdVCRFirst_Click
  1482. 'Init display with a special advertising plug for VB/ISAM:
  1483.     txtFind.Text = "VB/ISAM MX for Windows"
  1484.     cmdVCRSeek_Click
  1485. End Sub
  1486. Function DiscardChangesQuery ()
  1487.     MBType = MB_OKCANCEL + MB_ICONQUESTION + MB_DEFBUTTON2
  1488.     Msg = "OK to discard changes?" & CRLFDelim & CRLFDelim
  1489.     Msg = Msg & "(To save changes, click CANCEL, then 'Update Record' or 'Add Record' as appropriate.)"
  1490.     DiscardChangesQuery = MsgBox(Msg, MBType, MBTitle)
  1491. End Function
  1492. Sub DisplayCurrentRecord ()
  1493.     SuppressChangeEventFlag = True 'See txtFieldVal()_Change event procedure
  1494.     txtFieldVal(0).Text = PrimaryKey
  1495.     txtFieldVal(1) = RecordBuffer.Description
  1496.     txtFieldVal(2) = RecordBuffer.ProductCategory
  1497.     txtFieldVal(3) = RecordBuffer.FileType
  1498.     txtFieldVal(4) = Format$(RecordBuffer.BasePrice, "Currency")
  1499.     txtFieldVal(5) = RecordBuffer.PricingNotes
  1500.     txtFieldVal(6) = Format$(Val(RecordBuffer.CatalogPage), "0")
  1501.     txtFieldVal(7) = RecordBuffer.CompanyName
  1502.     txtFieldVal(8) = RecordBuffer.Phone
  1503.     txtFieldVal(9) = RecordBuffer.Fax
  1504.     txtFieldVal(10) = RecordBuffer.Comments
  1505.     SuppressChangeEventFlag = False    'see above
  1506.     ChangeAlertFlag = False     'init
  1507.     ClearOrRestoreToggle = 0  'For clear/restore button
  1508. End Sub
  1509. Sub EnableControls ()
  1510.     cmdInfo.Enabled = True
  1511.     cmdInfo.Picture = imgInfo.Picture
  1512.     cmdExport.Enabled = True
  1513.     cmdExport.Picture = imgExport.Picture
  1514.     cmdVCRFirst.Enabled = True
  1515.     cmdVCRFirst.Picture = imgVCRFirst.Picture
  1516.     cmdVCRLeft.Enabled = True
  1517.     cmdVCRLeft.Picture = imgVCRLeft.Picture
  1518.     cmdVCRRight.Enabled = True
  1519.     cmdVCRRight.Picture = imgVCRRight.Picture
  1520.     cmdVCRLast.Enabled = True
  1521.     cmdVCRLast.Picture = imgVCRLast.Picture
  1522.     cmdVCRSeek.Enabled = True
  1523.     cmdVCRSeek.Picture = imgVCRSeek.Picture
  1524.     txtFind.Enabled = True
  1525.     If DatasetAccessMode = READ_WRITE Then
  1526.         cmdClearDisplay.Enabled = True
  1527.         cmdClearDisplay.Picture = imgClearDisplay.Picture
  1528.         cmdAddRec.Enabled = True
  1529.         cmdAddRec.Picture = imgAddRec.Picture
  1530.         cmdDeleteRec.Enabled = True
  1531.         cmdDeleteRec.Picture = imgDeleteRec.Picture
  1532.         cmdUpdateRec.Enabled = True
  1533.         cmdUpdateRec.Picture = imgUpdateRec.Picture
  1534.         cmdRenameFields.Enabled = True
  1535.         cmdRenameFields.Picture = imgRenameFields.Picture
  1536.     Else
  1537.         cmdClearDisplay.Enabled = False
  1538.         cmdClearDisplay.Picture = imgDClearDisplay.Picture
  1539.         cmdAddRec.Enabled = False
  1540.         cmdAddRec.Picture = imgDAddRec.Picture
  1541.         cmdDeleteRec.Enabled = False
  1542.         cmdDeleteRec.Picture = imgDDeleteRec.Picture
  1543.         cmdUpdateRec.Enabled = False
  1544.         cmdUpdateRec.Picture = imgDUpdateRec.Picture
  1545.         cmdRenameFields.Enabled = False
  1546.         cmdRenameFields.Picture = imgDRenameFields.Picture
  1547.     End If
  1548. End Sub
  1549. Sub FlashDisplay ()
  1550.     picFieldDisplayArea.BackColor = GREEN
  1551.     tmrTimer1.Enabled = True    'When the timer goes off, we'll restore the light-gray color.
  1552. End Sub
  1553. Sub Form_Load ()
  1554.     Dim L, T As Integer
  1555.     Dim I As Integer
  1556.     rc = FP_Password("Use your real password in place of this string.")
  1557.     '**************************************************************
  1558.     '*
  1559.     '*   YOU MAY NOT DISTRIBUTE SOURCE CODE THAT INCLUDES YOUR
  1560.     '*   FIELDPACK PASSWORD.  THE CONFIDENTIALITY OF FIELDPACK
  1561.     '*   PASSWORDS IS ABSOLUTELY CRITICAL, AND SOFTWARE SOURCE
  1562.     '*   WILL PROSECUTE ANYONE WHO BREACHES THIS PROVISION OF
  1563.     '*   THE FIELDPACK SOFTWARE LICENSE.  THE FIELDPACK SOFTWARE
  1564.     '*   LICENSE IS CONTAINED IN THE FIELDPACK USER'S MANUAL,
  1565.     '*   FLDPAK12.WRI.
  1566.     '*
  1567.     '**************************************************************
  1568.     'Init:
  1569.     DatasetRefNum = 0
  1570.     ChangeAlertFlag = False
  1571.     BarDelim = "|"
  1572.     CRLFDelim = Chr$(13) & Chr$(10)    'CRLF
  1573.     MBTitle = "VB/ISAM Sample Program SAM4"
  1574.     'Load subordinate forms so their controls are available (but the forms are hidden).
  1575.     frmRenameFields.Hide
  1576.     frmInfo.Hide
  1577.     frmExport.Hide
  1578.     frmHelp.Hide
  1579.     'Center this form on the screen:
  1580.     T = (Screen.Height / 2) - (Me.Height / 2)
  1581.     L = (Screen.Width / 2) - (Me.Width / 2)
  1582.     Me.Move L, T
  1583. End Sub
  1584. Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
  1585.     If UnloadMode = 0 Then  'User chose "Close" from the control-box menu
  1586.         If ChangeAlertFlag = True Then
  1587.             rc = DiscardChangesQuery()
  1588.             If rc = IDOK Then
  1589.                 ChangeAlertFlag = False
  1590.             Else
  1591.                 Cancel = True   'Stop the unloading process
  1592.                 Exit Sub
  1593.             End If
  1594.         End If
  1595.     End If
  1596.     ExitProgram
  1597. End Sub
  1598. Sub FormatDatasetName ()
  1599. 'Surprise!  This procedure isn't used at all in this program.
  1600. 'I left it in (it's from VB/ISAM Data Editor) just
  1601. 'to show off a cute trick you can do with FieldPack.
  1602. 'This is how VB/ISAM Data Editor modifies long pathnames
  1603. 'for display: e.g., C:\ABCDEFGH\IJKLMNOP\...\XYZ
  1604. '    Dim WidthLimit As Integer
  1605. '    WidthLimit = Me.TextWidth(String$(28, "W")) 'form font is same as pnlDatasetName font
  1606.     '(The "28" is by experimentation.)
  1607. '    DatasetName = US_Reverse(Left$(cdbOpenADataset.Filename, Len(cdbOpenADataset.Filename) - 4))
  1608. '    If Me.TextWidth(DatasetName) > WidthLimit Then
  1609. '        DatasetName = DS_PutField(DatasetName, "\", 2, "...")
  1610. '        Do Until Me.TextWidth(DatasetName) <= WidthLimit
  1611. '            DatasetName = DS_RemoveField(DatasetName, "\", 3)
  1612. '        Loop
  1613. '    End If
  1614. '    DatasetName = US_Reverse(DatasetName)
  1615. End Sub
  1616. Sub InitSchema ()
  1617. 'This subroutine builds a default schema, and writes it out to a schema file (.ISS).
  1618. 'File format is:
  1619. 'First line of file: [BEGIN COMMENTS]
  1620. 'Zero to ?? lines: free-form comments
  1621. 'Line ???: [BEGIN SCHEMA]
  1622. 'Then:
  1623. 'One variable-length line (terminated by CRLF, for friendliness for other software) for each
  1624. 'field in the corresponding VB/ISAM dataset.  (The first line represents the primary key.)
  1625. 'Each line contains seven variable-length subfields, delimited by the "|" character
  1626. '(so there are six delimiters).  Subfields 3 through 7 can be empty.
  1627. 'Subfield 1: 3-char field number -- 000, 001, etc. (000 for the primary key.)
  1628. 'Subfield 2: field type -- taken from the dataset's standard record format string.
  1629. 'Subfield 3: field name
  1630. 'Subfield 4: display width (suggested use: for printed reports using monospaced type fonts)
  1631. 'Subfield 5: display justification -- L, C, or R (to go along with the previous subfield)
  1632. 'Subfield 6: reserved for Software Source
  1633. 'Subfield 7: user-defined.  Note that you can install a lower level of delimiter (perhaps a comma)
  1634. 'to create sub-sub-fields here if you wish.  Possibilities include display FontName, FontBold, etc.
  1635. 'Note that you can also have user-defined subfields beyond the 7th, perhaps for comments.
  1636.     Dim I As Integer
  1637.     TellUser (DEFAULT_SCHEMA)
  1638.     SchemaCommentHeader = "[BEGIN COMMENTS]" & CRLFDelim   'Note, one blank comment line.
  1639.     Schema = "000|P$*" & Format$(DatasetInfo.MaxPrimaryKeyLen, "0") & "|F000||||" & CRLFDelim
  1640.     For I = 1 To NumberOfFields
  1641.         Schema = Schema & Format$(I, "000") & "|" & FieldType(I) & "|F" & Format$(I, "000") & "||||" & CRLFDelim
  1642.     Next I
  1643.     If SchemaFileAccessibleFlag = True Then 'Don't try to write default schema file if we couldn't create it.
  1644.         'Write schema file:
  1645.         SchemaFileContents = SchemaCommentHeader & CRLFDelim & "[BEGIN SCHEMA]" & CRLFDelim & Schema
  1646.         Put #SchemaFileNum, , SchemaFileContents
  1647.         Close #SchemaFileNum
  1648.     End If
  1649. End Sub
  1650. Sub lblFieldName_Click (Index As Integer)
  1651.     Dim I As Integer
  1652.     For I = 0 To cboIndex.ListCount - 1
  1653.         If Val(Left$(cboIndex.List(I), 3)) = Index Then
  1654.             cboIndex.ListIndex = I
  1655.             Exit Sub
  1656.         End If
  1657.     Next I
  1658. End Sub
  1659. Sub RefindRecord ()
  1660.     'This routine is called from cboIndex_Click.
  1661.     'The idea is to establish the pointer in the new index at the position of the currently-
  1662.     'displayed record.  VmxGet always moves the pointer in the specified index.
  1663.     Dim TargetIndexValue As String
  1664.     Dim EncounteredIndexEntry As String
  1665.     If CurrentIndex = 0 Then    'i.e., we're in the primary index now:
  1666.         If PrimaryKey <> "" Then    'i.e., we haven't just deleted this record; seek to the current primary key:
  1667.             rc = VmxGet(DatasetRefNum, 0, XLOOKUP + XNO_DATA, PrimaryKey, Throwaway, PrimaryKey, Throwaway)
  1668.             If rc <> VIS_OK Then    'It better be there!
  1669.                 TellUser (GETERROR)
  1670.                 ExitProgram  'Panic exit
  1671.             End If
  1672.         Else    'PrimaryKey =0; i.e., we just deleted this record.  Display first record in index 0.
  1673.             cmdVCRFirst_Click
  1674.         End If
  1675.     Else    'The new index is a secondary index.  We need the current rec's index-field:
  1676.         Select Case CurrentIndex
  1677.         Case 2
  1678.             TargetIndexValue = RecordBuffer.ProductCategory
  1679.         Case 3
  1680.             TargetIndexValue = RecordBuffer.FileType
  1681.         Case 6
  1682.             TargetIndexValue = RecordBuffer.CatalogPage
  1683.         Case 7
  1684.             TargetIndexValue = RecordBuffer.CompanyName
  1685.         Case Else
  1686.             TellUser (99)   'Programming error.
  1687.             ExitProgram 'Panic exit
  1688.         End Select
  1689.         If TargetIndexValue = "" Then
  1690.             cmdVCRFirst_Click
  1691.         ElseIf PrimaryKey <> "" Then    'i.e., we haven't just deleted this record.
  1692.             'First, reposition to the first of several possible duplicates in the secondary index:
  1693.             SavedPrimaryKey = PrimaryKey    'Now, SavedPrimaryKey is the original record's primary key.
  1694.             rc = VmxGet(DatasetRefNum, CurrentIndex, XLOOKUP + XNO_DATA, TargetIndexValue, Throwaway, PrimaryKey, Throwaway)
  1695.             If rc <> VIS_OK Then    'It better be there!
  1696.                 TellUser (GETERROR)
  1697.                 ExitProgram  'Panic exit
  1698.             End If
  1699.             'Second, loop (if necessary) to reposition to the SPECIFIC entry in this index;
  1700.             'Note that we don't have to re-retrieve the dataset record because it's already here.
  1701.             'EXPLANATION:  VB/ISAM maintains a "primary" index of unique "primary keys," plus
  1702.             'up to 80 "secondary indexes," whose entries ("secondary keys") need not be unique.
  1703.             'Within each secondary index, if there are "duplicate keys," VB/ISAM maintains those
  1704.             'entries in ascending order by primary key.  For example, in an employee file with
  1705.             'primary key of Social Security Number (unique), all twenty-seven employees named
  1706.             '"Smith" will have adjacent entries in the last-name index, but those entries will
  1707.             'appear in ascending sequence by the corresponding Social Security Numbers.
  1708.             Do Until PrimaryKey = SavedPrimaryKey
  1709.                 rc = VmxGet(DatasetRefNum, CurrentIndex, XNEXT + XEQ + XNO_DATA, TargetIndexValue, Throwaway, PrimaryKey, Throwaway)
  1710.                 If rc <> VIS_OK Then
  1711.                     TellUser (GETERROR)
  1712.                     ExitProgram  'Panic exit
  1713.                 End If
  1714.             Loop
  1715.         Else    'PrimaryKey is 0; i.e., we just deleted this record.
  1716.             'The design decision is to display the record for the NEXT entry in the new index.
  1717.             'First, reposition to the first of several possible duplicates in the secondary index:
  1718.             '(Note that cmdDeleteRec saved the original Primary Key in "SavedPrimaryKey")
  1719.             rc = VmxGet(DatasetRefNum, CurrentIndex, XLOOKUP, TargetIndexValue, Throwaway, PrimaryKey, RecordBuffer)
  1720.             If rc = VIS_NOT_FOUND Then  'i.e., we're just deleted the ONLY such entry (no duplicates)
  1721.                 cmdVCRRight_Click
  1722.             ElseIf rc = VIS_OK Then     'i.e., there are duplicates; scan forward to just beyond where the entry used to be:
  1723.                 Do Until PrimaryKey > SavedPrimaryKey Or EncounteredIndexEntry > TargetIndexValue Or rc = VIS_NOT_FOUND
  1724.                     rc = VmxGet(DatasetRefNum, CurrentIndex, XNEXT, "", EncounteredIndexEntry, PrimaryKey, RecordBuffer)
  1725.                     If rc <> VIS_OK And rc <> VIS_NOT_FOUND Then
  1726.                         TellUser (GETERROR)
  1727.                         ExitProgram  'Panic exit
  1728.                     End If
  1729.                 Loop
  1730.                 'Now, we're either within the duplicates but just beyond the original primarykey,
  1731.                 'or we're at the (first of the) next (set of) secondary index values,
  1732.                 'or we're at EOF.
  1733.                 If rc = VIS_OK Then
  1734.                     DisplayCurrentRecord
  1735.                 Else    'at EOF in this index
  1736.                     cmdVCRLast_Click
  1737.                 End If
  1738.             End If
  1739.         End If
  1740.     End If
  1741. End Sub
  1742. Sub ResetForm ()
  1743.     picFieldDisplayArea.Visible = False
  1744.     ChangeAlertFlag = False
  1745.     pnlDatasetName.Caption = "Dataset name:  [click Open]"
  1746.     cboIndex.Clear
  1747.     txtFieldVal(CurrentIndex).BackColor = WHITE
  1748.     cmdInfo.Enabled = False
  1749.     cmdInfo.Picture = imgDInfo.Picture
  1750.     cmdRenameFields.Enabled = False
  1751.     cmdRenameFields.Picture = imgDRenameFields.Picture
  1752.     cmdExport.Enabled = False
  1753.     cmdExport.Picture = imgDExport.Picture
  1754.     cmdVCRFirst.Enabled = False
  1755.     cmdVCRFirst.Picture = imgDVCRFirst.Picture
  1756.     cmdVCRLast.Enabled = False
  1757.     cmdVCRLast.Picture = imgDVCRLast.Picture
  1758.     cmdVCRLeft.Enabled = False
  1759.     cmdVCRLeft.Picture = imgDVCRLeft.Picture
  1760.     cmdVCRRight.Enabled = False
  1761.     cmdVCRRight.Picture = imgDVCRRight.Picture
  1762.     cmdVCRSeek.Enabled = False
  1763.     cmdVCRSeek.Picture = imgDVCRSeek.Picture
  1764.     cmdClearDisplay.Enabled = False
  1765.     cmdClearDisplay.Picture = imgDClearDisplay.Picture
  1766.     cmdAddRec.Enabled = False
  1767.     cmdAddRec.Picture = imgDAddRec.Picture
  1768.     cmdDeleteRec.Enabled = False
  1769.     cmdDeleteRec.Picture = imgDDeleteRec.Picture
  1770.     cmdUpdateRec.Enabled = False
  1771.     cmdUpdateRec.Picture = imgDUpdateRec.Picture
  1772. End Sub
  1773. Sub tmrTimer1_Timer ()
  1774.     picFieldDisplayArea.BackColor = LIGHT_GREY
  1775.     tmrTimer1.Enabled = False
  1776. End Sub
  1777. Sub txtFieldVal_Change (Index As Integer)
  1778.     If SuppressChangeEventFlag = False Then    'i.e., if this event was triggered by a USER change:
  1779.         If DatasetAccessMode = READ_ONLY Then
  1780.             txtFieldVal(Index).Text = txtFieldVal(Index).Tag    'Restore original contents; see GotFocus event.
  1781.             Beep
  1782.         Else    'i.e., user change to a field with dataset open in read-write mode:
  1783.             ChangeAlertFlag = True
  1784.         End If
  1785.     End If
  1786. End Sub
  1787. Sub txtFieldVal_GotFocus (Index As Integer)
  1788.     'Prepare for possible restoration of original value if user
  1789.     'tries to change contents when in read-only mode:
  1790.     If DatasetAccessMode = READ_ONLY Then
  1791.         txtFieldVal(Index).Tag = txtFieldVal(Index).Text    'Save original contents
  1792.     End If
  1793. End Sub
  1794. Sub txtFieldVal_LostFocus (I As Integer)
  1795.     Dim TempInteger As Integer
  1796.     Dim TempLong As Long
  1797.     Dim TempSingle As Single
  1798.     Dim TempDouble As Double
  1799.     Dim TempCurrency As Currency
  1800.     Dim TempString As String
  1801. 'Reformat numeric fields, in case the user changed them:
  1802.     Select Case FieldType(I)
  1803.     Case "%"
  1804.         TempInteger = Val(US_StripOut((txtFieldVal(I).Text), ","))
  1805.         txtFieldVal(I).Text = Format$(TempInteger, "#,##0")
  1806.     Case "&"
  1807.         TempLong = Val(US_StripOut((txtFieldVal(I).Text), ","))
  1808.         txtFieldVal(I).Text = Format$(TempLong, "#,##0")
  1809.     Case "!"
  1810.         TempSingle = Val(US_StripOut((txtFieldVal(I).Text), ","))
  1811.         txtFieldVal(I).Text = Format$(TempSingle, "Scientific")
  1812.     Case "#"
  1813.         TempDouble = Val(US_StripOut((txtFieldVal(I).Text), ","))
  1814.         txtFieldVal(I).Text = Format$(TempDouble, "Scientific")
  1815.     Case "@"
  1816.         TempCurrency = Val(US_StripOut((txtFieldVal(I).Text), ",$"))
  1817.         txtFieldVal(I).Text = Format$(TempCurrency, "Currency")
  1818.     Case Else   'either $ or $*nnn
  1819.     End Select
  1820. End Sub
  1821.